Turnbull China Bikeride/Turnbull China Bikeride - Disc 2.iso/BARNET/COMPILER/SATHER/!Sather/Library/Graphs/sa/digrph_alg

Text File | 1996-07-13 | 8KB | 197 lines

---------------------------> Sather 1.1 source file <--------------------------
-- Author: Benedict A. Gomes <[e-mail]>
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.
-------------------------------------------------------------------
class DIGRAPH_ALG{NTP} is
   -- The default version of the algorithm class expects node indices
   -- of type NTP and will any kind of read-only directed graph.
   -- Using this version simplifies some uses but can be significantly
   -- less efficient
   include DIGRAPH_ALG{INT,$RO_DIGRAPH{INT}};

end;
-------------------------------------------------------------------
class DIGRAPH_ALG{NTP, GTP < $RO_DIGRAPH{NTP}} is
   -- NTP is the node index type and GTP is the graph type
   --
   -- A collection of some very simple graph traversal algorithms
   --
   -- All the following routines assume that the graph is acyclic.
   -- They may go into an infinite loop or fail in some other way if
   -- the graph contains cycles.
   -- Usage:
   --     g: DIGRAPH{INT} := #;
   --     n1 ::= g.add_node(1);
   --     n2 ::= g.add_node(2);
   --     n3 ::= g.add_node(3)
   --     g.connect(n1,n2); g.connect(n1,n3);
   --     Constructs:
   --      1
   --      /\
   --     2  3
   --
   --     Getting the layers of the graph:
   --        l: LIST{SET{INT}} := #;
   --        loop s: SET{INT} := DIGRAPH_ALG::layer!(g);
   --             l := l.append(s);
   --         end;

   source!(once g: GTP): NTP is
      -- Yield all source nodes in the graph "g"
      loop n ::= g.node!;  if g.n_incoming(n) = 0 then yield n end; end;
   end;

   sink!(once g: GTP): NTP is
      -- Yield all sink nodes in the graph "g"
      loop n ::= g.node!;  if g.n_outgoing(n) = 0 then yield n end; end;
   end;

   bf!(once g: GTP,once n: NTP): NTP is
      -- Return all nodes reachable from "n" in breadth first order
      -- With inout arguments, also return the depth of the node
      depths: FMAP{NTP,INT} := #;
      q: A_QUEUE{NTP} := #;
      q.enq(n);
      depths := depths.insert(n,0);
      loop until!(q.is_empty);
     current ::= q.remove;
     node_depth: INT := depths.get(current);
     yield current;
     child_node_depth: INT := node_depth + 1;
     loop out_node ::= g.outgoing!(current);
        if ~depths.has_ind(out_node) then
           q.enq(out_node);
           depths:=depths.insert(out_node,child_node_depth);
        end;
     end;
      end;
   end;

   df!(once g: GTP,once n: NTP): NTP is
      -- Return all nodes reachable from "n" in depth first order
      stack ::= #FLIST{NTP};  stack := stack.push(n);
      depths  ::= #FMAP{NTP,INT};   depths := depths.insert(n,0);
      loop until!(stack.is_empty);
     cur ::= stack.pop;
     cur_depth: INT := depths.get(cur);
     yield cur;        -- Actual visit
     child_depth: INT := cur_depth+1;
     loop neigh ::= g.outgoing!(cur);
        if ~depths.has_ind(neigh) then
           stack:=stack.push(neigh);
           depths:=depths.insert(neigh,child_depth);
        end; -- else ( Neighbor has been seen before => backedge.)
     end;
      end; -- Until stack is empty
   end;

   topo_order!(once g: GTP): NTP is
      -- Yield nodes in topological order
      if g.is_empty then quit end;
      -- Current indegree holds the current number of incoming per node
      -- When the number of incoming goes to zero, the node is
      -- visited and the current indegree values of all its outgoing  are
      -- decremented.
      current_indeg ::= #FMAP{NTP,INT};
      -- Mapping from nodes to living incoming
      roots ::= #FLIST{NTP};    -- Root nodes
      loop n: NTP := g.node!;
     deg ::= g.n_incoming(n);
     current_indeg := current_indeg.insert(n,deg);
     if (deg = 0) then roots := roots.push(n); end;
      end;
      loop while!(roots.size > 0);
     ni ::= roots.pop;
     -- Yield the next node in topological order
     yield(ni);
     loop out_node ::= g.outgoing!(ni);
        outgoing_indegree ::= current_indeg.get(out_node);
        new_out_indeg ::= outgoing_indegree - 1;
        current_indeg:=current_indeg.insert(out_node,new_out_indeg);
        if (new_out_indeg=0) then roots := roots.push(out_node);  end;
     end;
      end;
   end;

   is_topo_order(g: GTP,nodes: $ARR{NTP}): BOOL is
      -- Verify that the nodes in "node_order" are in topological order,
      -- that each node's order is greater than the order of any
      -- of its parents. Better methods probably exist...
      node_order ::= #FMAP{NTP,INT};
      loop node_order:=node_order.insert(nodes.elt!, nodes.size.times!) end;
      loop
     node_depth_tup: TUP{NTP,INT} := node_order.pair!;
     child: NTP:=node_depth_tup.t1; child_order: INT := node_depth_tup.t2;
     if g.has_node(child) then
        loop parent: NTP := g.incoming!(child);
           if node_order.has_ind(parent) then
          parent_order: INT := node_order.get(parent);
          if parent_order >= child_order then
             return false;
          end;
           end; -- Ignore the parent if it is not in the order
        end; -- End of loop on parents
     end; -- End of if has_node(child).
     -- If the child is not in the current graph, also ignore it
      end;
      return true;
   end;

   layer!(once g: GTP): SET{NTP} is
      -- Return the "layers" of the graph, i.e. peel off successive root
      -- sets
      -- Current indegree holds the current number of incoming per node
      -- When the number of incoming goes to zero, the node is
      -- visited and the current indegree values of all its outgoing  are
      -- decremented.
      -- All nodes/edges start out live.
      -- Loop, at each iteration:
      --    Find the nodes that have no live incoming edges and  yield them
      --    Mark the nodes and all edges going out of them as dead
      -- Until no more nodes are left alive

      li::= #FMAP{NTP,INT}; -- Maps nodes to the number of live incoming edges
      dead ::= #SET{NTP};      -- Root nodes, current dead set
      nodes_left: INT := g.n_nodes; -- Number of live nodes left
      loop n: NTP := g.node!;
     deg ::= g.n_incoming(n);
     li := li.insert(n,deg);
     if (deg = 0) then dead.insert(n); end;
      end;
      yield dead;
      nodes_left := nodes_left - dead.size;
      new_dead: SET{NTP};
      loop while!(nodes_left > 0);
     new_dead := #SET{NTP};
     loop r ::= dead.elt!;
        -- Indicate that the outgoing edges from the old root set
        -- are now dead
        loop out_node ::= g.outgoing!(r);
           -- Get the current live indegree of the node "out_node"
           indeg_of_out_node: INT := li.get(out_node);
           -- Reduce the number of "live"  edges into "out_node"
           -- by 1 since "r", a parent root,  has been yielded and is dead
           new_live_indegree_of_out_node ::= indeg_of_out_node - 1;
           li := li.insert(out_node,new_live_indegree_of_out_node);
           -- If there are no more "live" incoming edges to "out_node",
           -- yield it. Out_node is now dead
           if new_live_indegree_of_out_node = 0 then
          new_dead.insert(out_node);
           end;
        end; -- End of loop around outgoing nodes of a root
     end; -- End of loop through old dead
     yield new_dead;
     nodes_left := nodes_left - new_dead.size;
     dead := new_dead;
     -- Note: We cannot re-use the old dead's space since it might
     -- be in use outside this routine
      end;
   end;

end;
-------------------------------------------------------------------